home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjjl86.arc / MATRIX2.PAS < prev    next >
Pascal/Delphi Source File  |  1986-05-07  |  3KB  |  140 lines
  1. {$real:8}
  2. {$floatcalls-}
  3. PROGRAM MATRIX(INPUT,OUTPUT);  { For MS Pascal }
  4.  
  5. (* By Alan R. Miller; modified by Jeff Duntemann *)
  6. (* from: PASCAL PROGRAMS FOR SCIENTISTS AND ENGINEERS *)
  7. (* (c) 1981 by Sybex, Inc. *)
  8.  
  9. CONST
  10.   RMAX = 20;
  11.   CMAX = 20;
  12.  
  13. TYPE
  14.   ARY    = ARRAY[1..RMAX] OF REAL;
  15.   ARYS    = ARRAY[1..CMAX] OF REAL;
  16.   ARY2    = ARRAY[1..RMAX, 1..CMAX] OF REAL;
  17.   ARY2S = ARRAY[1..RMAX, 1..CMAX] OF REAL;
  18.   STRING80 = LSTRING(80);
  19.  
  20. VAR
  21.   Y    : ARY;
  22.   G    : ARYS;
  23.   X    : ARY2;
  24.   A    : ARY2S;
  25.   NROW,NCOL    : INTEGER;
  26.   CH    : CHAR;
  27.   I : INTEGER;
  28.   O : TEXT;
  29.  
  30. FUNCTION TICS : WORD; EXTERN;
  31. PROCEDURE TIME(VAR S : STRING); EXTERN;
  32.  
  33. PROCEDURE Show_Time(VAR OutFile : Text);
  34.  
  35. VAR
  36.   TimeString : LSTRING(15);
  37.  
  38. BEGIN
  39.   TimeString := '        ';
  40.   Time(TimeString);
  41.   Writeln(OutFile,TimeString,'.',Tics:2);
  42. END;
  43.  
  44. PROCEDURE GET_DATA(VAR X : ARY2;
  45.            VAR Y : ARY;
  46.            VAR NROW,NCOL : INTEGER);
  47.  
  48. (* Get values for NROW, NCOL, and arrays X, Y *)
  49.  
  50. VAR I,J : INTEGER;
  51.  
  52. BEGIN
  53.   NROW:=10;
  54.   NCOL:=10;
  55.   FOR I:=1 TO NROW DO
  56.     BEGIN
  57.       X[I,1]:=1;
  58.       FOR J:=2 TO NCOL DO
  59.         X[I,J]:=I*X[I,J-1];
  60.       Y[I]:=2*I
  61.     END
  62. END;    (* GET_DATA *)
  63.  
  64. PROCEDURE WRITE_DATA;
  65.  
  66. (* Print out the answers *)
  67.  
  68. VAR I,J : INTEGER;
  69.  
  70. BEGIN
  71.   WRITELN;
  72.   WRITELN('       X                          Y');
  73.   FOR I:=1 TO NROW DO
  74.     BEGIN
  75.       FOR J:=1 TO NCOL DO
  76.     WRITE(X[I,J]:9:1,' ');
  77.       WRITELN(':',Y[I]:9:1)
  78.     END;
  79.   WRITELN;
  80.   WRITELN('       A                          G');
  81.   FOR I:=1 TO NCOL DO
  82.     BEGIN
  83.       FOR J:=1 TO NCOL DO
  84.       WRITE(A[I,J]:10:1,' ');
  85.       WRITELN(':',G[I]:10:1)
  86.     END
  87. END;  (* WRITE_DATA *)
  88.  
  89. PROCEDURE SQUARE(X    : ARY2;
  90.          Y    : ARY;
  91.          VAR A    : ARY2S;
  92.          VAR G  : ARYS;
  93.          NROW,NCOL : INTEGER);
  94.  
  95. (* Matrix multiplication routine *)
  96. (* A = transpose X times X       *)
  97. (* G = Y times X         *)
  98.  
  99. VAR I,K,L : INTEGER;
  100.  
  101. BEGIN  (* SQUARE *)
  102.   FOR K:=1 TO NCOL DO
  103.     BEGIN
  104.       FOR L:=1 TO K DO
  105.     BEGIN
  106.       A[K,L]:=0;
  107.       FOR I:=1 TO NROW DO
  108.         BEGIN
  109.           A[K,L]:=A[K,L]+X[I,L]*X[I,K];
  110.           IF K<>L THEN A[L,K]:=A[K,L]
  111.         END
  112.     END;    (* L loop *)
  113.       G[K]:=0;
  114.       FOR I:=1 TO NROW DO
  115.         G[K]:=G[K]+Y[I]*X[I,K]
  116.     END         (* K loop *)
  117. END;  (* SQUARE *)
  118.  
  119. BEGIN    (* MAIN *)
  120.   { Open timings file: }
  121.   Assign(O,'MATTIME.MS');
  122.   Rewrite(O);
  123.   Writeln(O,'Matrix benchmark timings for Microsoft Pascal V3.31: ');
  124.   Writeln(O,' ');
  125.  
  126.   WRITE(O,'>>Starting matrix multiply time test at ');
  127.   SHOW_TIME(O);
  128.   FOR I := 1 TO 10 DO
  129.     BEGIN
  130.       GET_DATA(X,Y,NROW,NCOL);
  131.       SQUARE(X,Y,A,G,NROW,NCOL);
  132.     END;
  133.   WRITE(O,'                             ...done at ');
  134.   SHOW_TIME(O);
  135.   CLOSE(O);
  136.   WRITE('>>Press (CR) to display the matrix: ');
  137.   READLN;
  138.   WRITE_DATA
  139. END.
  140.